home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / goushad / shading.txt < prev   
Encoding:
Text File  |  1994-09-01  |  50.1 KB  |  2,106 lines
  1. Hello Dudes ...
  2.  
  3. I was away for a longer weekend and when I came back I saw there was quite
  4. some discussion about certain aspects of my person and my code.
  5.  
  6. I remember posting some controversial statements which I thought would lead
  7. to some discussion and widen the horizon of some people who only believe the
  8. things what the computer magazines and the so-called gurus say.
  9.  
  10. Well, there was some reaction I didn't quite like - some guys reacted quite
  11. childish in the way of this-is-not-the-way-it's-done-therefore-you-are-an-
  12. idiot-and-we-laugh-at-you. Way under there age (or?). Which made me quite angry
  13. so I replied hard at them. Most of it was crap anyway - lamers who thought they
  14. could prove me wrong and made themselves laughed at by others, when they tried
  15. to improve the 16bit code in 32bit mode. NONE of it works, as I was claiming
  16. before and was flamed with crap from the people who have to boost their ego.
  17.  
  18. Another thing was the statement about the Gouraud code with 0.25 instructions
  19. per pixel. I wrote that only 'coz I was surprised that people still thought it
  20. was so expensive ... while I replaced it with Phong shading already.
  21. According to the replies I got, where people actually thought I meant 1/4 of a
  22. frame and stuff like that, they act like when-I-cannot-do-that-how-can-HE-do-
  23. that-MUST-be-some-sort-of-error-or-else-I'd-be-lame.
  24. Some people really think that their code is optimized or so, and nothing can
  25. get faster - well it's not impossible to optimize even more, you'd be
  26. surprised.
  27.  
  28. NEVER EVER say your code is optimized, somebody can come and make it faster -
  29. and if it is with the new Pentium execution unit, or with some new undocumented
  30. feature.
  31.  
  32. Therefore below's the code for it. You may want to get my released sources/
  33. intros and look at them. Then let's argue again ...
  34.  
  35. Something else about giving code out.
  36. It's definitely *NOT* in use for demo groups to give code out.
  37. While it may be 'in' for some American demo groups to do that, we Europeans
  38. started out without all those tutorials - most of us don't have Internet access
  39. or a modem anyway. Enough about this.
  40. But I find today's attitude of 'HAVING to give code out, if you mention you
  41. have a good method' lame - there's a increasing majority of newbies who
  42. actually DEMAND that, 'coz they're used to it. Like the 'if he holds his code
  43. back we'll flame him till he gives us!' approach. I fucking hate those LAMERS.
  44. Try to see it as a GIFT, and not as your right! Nevertheless I released some,
  45. and I'll probably still do ... However, would you give your code/technique/
  46. tricks gratefully to guys who flame you?
  47.  
  48. Most of those lamers don't have anything to prove they can code, actually.
  49. Everybody can snap up a few bits of 'on how to do this and that', and no matter
  50. if it's wrong or right, flame all who are of a different opinion. I think
  51. that's what is called being fascist.
  52.  
  53. Let's take for example DOOM: Lot's of people 'claim' they've coded/are coding
  54. it - I don't know who turned up with the argument that DOOM be ray casting,
  55. but I bet the ID guys were laughing their ass off when that thread about it was
  56. taking place ;)   It may lie in their interest to disinform the public as they
  57. want to sell their routine's technology, or?   (This is only an assumption and
  58. no accusation, dudes).
  59. You probably could make it ray casting, but I'd strongly doubt you'd reach the
  60. speed of the original. Well, how do I come to that conclusion? Me, and some of
  61. the leading demo coders agree on that. (There's an example with ray casting,
  62. called ACK3D, but it doesn't reach the speed of Wolf3D by far, as you can see,
  63. and for floor/ceiling the ratio is worse ...)
  64.  
  65. Laugh at me, but as a demo coder I'm testing algorithms due to their usability
  66. and performance. And I don't select the most sophisticated one, but the one who
  67. fulfills the needs of the routine. For example, I've never bothered with BSP-
  68. trees - I know about the algorithm - but I see no use for it.
  69. What I'm trying to say, you shouldn't blindly follow those who call themselves
  70. Gurus, but try to look what's behind it.
  71. I know that some guys will flame me, either for this attitude, or for some
  72. little bugs they find in my routine, or some unoptimized ASM instructions.
  73. Those fuckers should really get a life.
  74.  
  75. I thank all those who know me, have seen my routines and support me in this
  76. group - You know who you are!
  77.  
  78.  
  79. -----------------------RIP this code here, lamers------------------------------
  80.  
  81.  
  82.  
  83. Signed, The Faker (S!P Internet PR)
  84.  
  85.  
  86.  
  87. _____________________________________________________________
  88. \                                    \                       \
  89.  |   "No one told you when to run,    |  in fake life:        |
  90.  |    you missed the starting gun."   |  Stefan Ohrhallinger  |
  91.  |                                    |    St. Laurenz 54     |
  92.  |   SURPRISE! PRODUCTIONS, AUSTRIA   |    A-4950 ALTHEIM     |
  93.  |                                    |                       |
  94.  |        "lightyears ahead!"         |  +43-732-2457-1025    |
  95.  |   __________________________________\_______________________\__
  96.   \_/____________________________________________________________/
  97.  
  98.  
  99.  
  100.  
  101.  
  102. I really don't care what you're doing with it, 'coz for me it's obsolete ...
  103. Why? It's been coded a year before, I never optimized anything except the inner
  104. loop, so my Phong stuff is faster now.
  105. And it's an example of provement, not a full-documented well-structured nice-
  106. ascii-pictured anal-retentive code - I've got better things to do.
  107.  
  108. compile:        tp -G+ gourex.pas
  109. run:            gourex sphere 2 x g
  110.  
  111. {Gourex.PAS----------------------------------------------------------}
  112.  
  113. {$R-,S-}
  114.  
  115. {{$DEFINE TIMER}
  116. {{$DEFINE MEASURE}
  117. {{$DEFINE GLENZ}
  118. {{$DEFINE FILLING}
  119.  
  120. PROGRAM ObjectsIn3D;
  121.  
  122. USES
  123.         Crt,Dos;
  124.  
  125. CONST
  126.     MaxPoints=700;
  127.     MaxFaces=1200;
  128.     MaxObjects=1;
  129.     MaxFaceCount=4;
  130.     LightSpot=0.2;
  131.  
  132. TYPE
  133.     ByteArray=ARRAY[0..65534] OF Byte;
  134.     WordArray=ARRAY[0..32766] OF Word;
  135.     L=RECORD
  136.             Lo:Word;
  137.             Hi:Integer;
  138.     END;
  139.  
  140.     FaceTyp=RECORD
  141.             P:ARRAY[1..MaxFaceCount] OF Word;
  142.             FaceTyp:Byte;
  143.             Light,FarZ:Integer;
  144.     END;
  145.  
  146.     ObjectTyp=RECORD
  147.             NrFaces:Word;
  148.             Face:ARRAY[1..MaxFaces] OF FaceTyp;
  149.     END;
  150.  
  151.     DrawModeTyp=(Delete,Plain,Goraud);
  152.             BigArray=ARRAY[0..254,0..255] OF Byte;
  153.             VecType=ARRAY[0..2] OF Integer;
  154.             LongVecType=ARRAY[0..2] OF LongInt;
  155.  
  156.  
  157. VAR
  158.     XOfs,YOfs,ZOfs:LongInt;
  159.     Point:ARRAY[1..MaxPoints,1..3] OF LongInt;
  160.     Dot:ARRAY[1..MaxPoints,1..3] OF Integer;
  161.     EdgeLight:ARRAY[1..MaxPoints] OF Integer;
  162.     EdgeVec:ARRAY[1..MaxPoints,0..2] OF Integer;
  163.     EdgeNorm:ARRAY[1..MaxPoints] OF LongInt;
  164.     EdgeVecCount,EdgeLightCount:ARRAY[1..MaxPoints] OF Byte;
  165.     Objects:ARRAY[1..MaxObjects] OF ObjectTyp;
  166.     NrPoints,ObjectCount:Integer;
  167.     Sinus:ARRAY[0..900] OF LongInt;
  168.     I,J,Segment,Phase:Word;
  169.     U,V,W,XX,YY,XRes,YRes,ZRes,Error:Integer;
  170.     SinU,CosU,SinV,CosV,SinW,CosW,M1,M2,M3,M4,M5,M6,M7,M8,M9,X,Y,Z,Temp,
  171.     ScalX,ScalY,ScalZ,Quotient:LongInt;
  172.     BallSpr:Pointer;
  173.     NoVert,Flip,Lighted,Texture,TinyTexture,Gouraud,Phong,ModeX,
  174.     PhongTexture,PerspectiveTexture:Boolean;
  175.     R,G,B:Byte;
  176.     LineTable1:ARRAY[0..319] OF Byte;
  177.     LineTable2:ARRAY[0..319] OF Byte;
  178.     GTable:ARRAY[0..127] OF Word;
  179.     Timer:Byte ABSOLUTE $40:$6C;
  180.     LastTimer:Byte;
  181.     Dummy,SqrtTable:ARRAY[0..4095] OF Byte;
  182.     LX,LY,LZ:Integer;
  183.     LNorm:LongInt;
  184.     Light3:ARRAY[1..3] OF Integer;
  185.     SortedFace:ARRAY[0..MaxFaces] OF Integer;
  186.     SaveInt09:Pointer;
  187.     Key:ARRAY[0..127] OF Boolean;
  188.     VirtualScreen,TinyTextureSpr:Pointer;
  189.     PhongTable,PalTable,TextureData:^ByteArray;
  190.     Palette:ARRAY[0..255,0..2] OF Byte;
  191.     DivWTable:^WordArray;
  192.     Zeit:LongInt;
  193.     Ticker:LongInt ABSOLUTE $40:$6C;
  194.  
  195. FUNCTION IntSqrt(L:LongInt):LongInt;
  196.  
  197. BEGIN
  198. END;
  199.  
  200.  
  201.  
  202. PROCEDURE NewInt09; INTERRUPT;
  203.  
  204. VAR
  205.      KeyCode:Byte;
  206.  
  207. BEGIN
  208.     ASM
  209.         in al,60h
  210.         mov keycode,al
  211.         in al,61h
  212.         mov ah,al
  213.         or al,80h
  214.         out 61h,al
  215.         mov al,ah
  216.         out 61h,al
  217.         mov al,20h
  218.         out 20h,al
  219.     END;
  220.     IF KeyCode<128 THEN Key[KeyCode]:=TRUE
  221.         ELSE Key[KeyCode AND 127]:=FALSE;
  222. END;
  223.  
  224. FUNCTION NormSin(W:Integer):LongInt;
  225.  
  226. BEGIN
  227.     IF W>1800 THEN
  228.         IF W>2700 THEN
  229.                  NormSin:=-Sinus[3600-W]
  230.                         ELSE NormSin:=-Sinus[W-1800]
  231.                              ELSE
  232.                                  IF W>900 THEN NormSin:=Sinus[1800-W]
  233.                                         ELSE NormSin:=Sinus[W];
  234. END;
  235.  
  236. FUNCTION NormCos(W:Integer):LongInt;
  237.  
  238. BEGIN
  239.     IF W>1800 THEN
  240.          IF W>2700 THEN
  241.                  NormCos:=Sinus[W-2700]
  242.                         ELSE NormCos:=-Sinus[2700-W]
  243.                              ELSE
  244.                                  IF W>900 THEN NormCos:=-Sinus[W-900]
  245.                                         ELSE NormCos:=Sinus[900-W];
  246. END;
  247.  
  248. PROCEDURE ReadObject(FileName:String);
  249.  
  250. VAR
  251.      ObjectFile:Text;
  252.      I,ObjectNr,CoordOfs:Integer;
  253.      Command,DummyStr:String;
  254.      R:Real;
  255.      ObjScalX,ObjScalY,ObjScalZ,ObjMoveX,ObjMoveY,ObjMoveZ:Real;
  256.  
  257. PROCEDURE ReadNextLine;
  258.  
  259. BEGIN
  260.     WHILE NOT Eof(ObjectFile) AND EOLn(ObjectFile) DO
  261.     ReadLn(ObjectFile);
  262. END;
  263.  
  264. PROCEDURE Upper(VAR S:String);
  265.  
  266. VAR
  267.     I:Byte;
  268.  
  269. BEGIN
  270.     FOR I:=1 TO Length(S) DO
  271.         S[I]:=UpCase(S[I]);
  272. END;
  273.  
  274. PROCEDURE ExecCommand;
  275.  
  276. PROCEDURE ExecObjectCommand;
  277.  
  278. PROCEDURE ReadCoords;
  279.  
  280. BEGIN
  281.     WHILE NOT EOLn(Objectfile) DO
  282.     BEGIN
  283.         IF NrPoints>MaxPoints THEN
  284.         BEGIN
  285.             WriteLn('Too many points, max. is currently ',maxpoints);
  286.             Halt(1);
  287.         END;
  288.         Inc(NrPoints);
  289.         Read(ObjectFile,R);
  290.         Point[NrPoints,1]:=Round((R*ObjScalX+ObjMoveX)*65536);
  291.         Read(ObjectFile,R);
  292.         Point[NrPoints,2]:=Round((R*ObjScalY+ObjMoveY)*65536);
  293.         Read(ObjectFile,R);
  294.         Point[NrPoints,3]:=Round((R*ObjScalZ+ObjMoveZ)*65536);
  295.         ReadLn(ObjectFile);
  296.     END;
  297. END;
  298.  
  299.  
  300.  
  301. PROCEDURE ReadFaces;
  302.  
  303. BEGIN
  304.     WITH Objects[ObjectCount] DO
  305.     BEGIN
  306.         NrFaces:=0;
  307.         WHILE NOT EOLn(ObjectFile) DO
  308.         BEGIN
  309.             IF NrFaces>MaxFaces THEN
  310.             BEGIN
  311.                 WriteLn('Too many faces, max. is currently ',maxfaces);
  312.                 Halt(1);
  313.             END;
  314.             Inc(NrFaces);
  315.             WITH Face[NrFaces] DO
  316.             BEGIN
  317.                 FaceTyp:=0;
  318.                 WHILE NOT EOLn(ObjectFile) DO
  319.                 BEGIN
  320.                     Inc(FaceTyp);
  321.                     Read(ObjectFile,P[FaceTyp]);
  322.                     Inc(P[FaceTyp],CoordOfs);
  323.                 END;
  324.                 ReadLn(ObjectFile);
  325.             END;
  326.         END;
  327.     END;
  328. END;
  329.  
  330. BEGIN
  331.     IF Command='SCAL' THEN
  332.     BEGIN
  333.         ReadLn(ObjectFile,ObjScalX);
  334.         ObjScalY:=ObjScalX;
  335.         ObjScalZ:=ObjScalX;
  336.     END
  337.         ELSE
  338.     IF Command='SCALX' THEN ReadLn(ObjectFile,ObjScalX)
  339.         ELSE
  340.     IF Command='SCALY' THEN ReadLn(ObjectFile,ObjScalY)
  341.         ELSE
  342.     IF Command='SCALZ' THEN ReadLn(ObjectFile,ObjScalZ)
  343.         ELSE
  344.     IF Command='MOVE' THEN
  345.         BEGIN
  346.             ReadLn(ObjectFile,ObjMoveX);
  347.             ObjMoveY:=ObjMoveX;
  348.             ObjMoveZ:=ObjMoveX;
  349.         END
  350.         ELSE
  351.     IF Command='MOVEX' THEN ReadLn(ObjectFile,ObjMoveX)
  352.         ELSE
  353.     IF Command='MOVEY' THEN ReadLn(ObjectFile,ObjMoveY)
  354.         ELSE
  355.     IF Command='MOVEZ' THEN ReadLn(ObjectFile,ObjMoveZ)
  356.         ELSE
  357.     IF Command='COORDS' THEN
  358.         BEGIN
  359.             ReadNextLine;
  360.             ReadCoords;
  361.         END
  362.          ELSE
  363.     IF Command='FACES' THEN
  364.         BEGIN
  365.             ReadNextLine;
  366.             ReadFaces;
  367.         END;
  368.     END;
  369.         BEGIN
  370.             IF Command='SCAL' THEN
  371.             BEGIN
  372.                 ReadLn(ObjectFile,R);
  373.                 ScalX:=Round(R*65536);
  374.                 ScalY:=ScalX;
  375.                 ScalZ:=ScalX;
  376.             END
  377.                 ELSE
  378.                     IF Command='SCALX' THEN
  379.                     BEGIN
  380.                         ReadLn(ObjectFile,R);
  381.                         ScalX:=Round(R*65536);
  382.                     END
  383.                 ELSE
  384.                 IF Command='SCALY' THEN
  385.                 BEGIN
  386.                     ReadLn(ObjectFile,R);
  387.                     ScalY:=Round(R*65536);
  388.                 END
  389.                 ELSE
  390.                 IF Command='SCALZ' THEN
  391.                 BEGIN
  392.                     ReadLn(ObjectFile,R);
  393.                     ScalZ:=Round(R*65536);
  394.                 END
  395.                 ELSE
  396.                 IF Command='OBJECT' THEN
  397.                 BEGIN
  398.                     Inc(ObjectCount);
  399.                     ObjScalX:=1.0;
  400.                     ObjScalY:=1.0;
  401.                     ObjScalZ:=1.0;
  402.                     ObjMoveX:=0.0;
  403.                     ObjMoveY:=0.0;
  404.                     ObjMoveZ:=0.0;
  405.                     CoordOfs:=NrPoints;
  406.                     ReadLn(ObjectFile,DummyStr);
  407.                     REPEAT
  408.                         ReadNextLine;
  409.                         Read(ObjectFile,Command);
  410.                         Upper(Command);
  411.                         ExecObjectCommand;
  412.                     UNTIL Command='OBJEND';
  413.                 END;
  414.      END;
  415.  
  416. BEGIN
  417.     ObjectCount:=0;
  418.     ScalX:=65536;
  419.     ScalY:=65536;
  420.     ScalZ:=65536;
  421.     Assign(ObjectFile,FileName+'.XYZ');
  422.     Reset(ObjectFile);
  423.     WHILE NOT Eof(ObjectFile) DO
  424.     BEGIN
  425.         ReadNextLine;
  426.         ReadLn(ObjectFile,Command);
  427.         Upper(Command);
  428.         ExecCommand;
  429.     END;
  430.     Close(ObjectFile);
  431. END;
  432.  
  433. PROCEDURE XForm(X,Y,Z:LongInt);
  434.  
  435. BEGIN
  436.     ASM
  437.         db $66
  438.         mov bx,word ptr x
  439.         db $66
  440.         add bx,word ptr xofs
  441.         db $66
  442.         mov cx,word ptr y
  443.         db $66
  444.         add cx,word ptr yofs
  445.         db $66
  446.         mov di,word ptr z
  447.         db $66
  448.         add di,word ptr zofs
  449.         { X }
  450.         db $66
  451.         mov ax,word ptr m1
  452.         db $66
  453.         imul bx
  454.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  455.         db $66
  456.         mov si,ax
  457.         db $66
  458.         mov ax,word ptr m2
  459.         db $66
  460.         imul cx
  461.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  462.         db $66
  463.         add si,ax
  464.         db $66
  465.         mov ax,word ptr m3
  466.         db $66
  467.         imul di
  468.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  469.         db $66
  470.         add si,ax
  471.         db $66
  472.         mov ax,word ptr scalx
  473.         db $66
  474.         imul si
  475.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  476.         db $66
  477.         shr ax,10h
  478.         mov word ptr xres,ax
  479.         { Y }
  480.         db $66
  481.         mov ax,word ptr m4
  482.         db $66
  483.         imul bx
  484.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  485.         db $66
  486.         mov si,ax
  487.         db $66
  488.         mov ax,word ptr m5
  489.         db $66
  490.         imul cx
  491.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  492.         db $66
  493.         add si,ax
  494.         db $66
  495.         mov ax,word ptr m6
  496.         db $66
  497.         imul di
  498.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  499.         db $66
  500.         add si,ax
  501.         db $66
  502.         mov ax,word ptr scaly
  503.         db $66
  504.         imul si
  505.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  506.         db $66
  507.         shr ax,10h
  508.         mov word ptr yres,ax
  509.         { Z }
  510.         db $66
  511.         mov ax,word ptr m7
  512.         db $66
  513.         imul bx
  514.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  515.         db $66
  516.         mov si,ax
  517.         db $66
  518.         mov ax,word ptr m8
  519.         db $66
  520.         imul cx
  521.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  522.         db $66
  523.         add si,ax
  524.         db $66
  525.         mov ax,word ptr m9
  526.         db $66
  527.         imul di
  528.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  529.         db $66
  530.         add si,ax
  531.         db $66
  532.         mov ax,word ptr scalz
  533.         db $66
  534.         imul si
  535.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  536.         db $66
  537.         shr ax,10h
  538.         mov word ptr zres,ax
  539.     END;
  540.     IF Texture OR PhongTexture THEN Exit;
  541.     IF ZRes=-225 THEN   Inc(ZRes);
  542.     XRes:=-(LongInt(XRes) SHL 8) DIV (ZRes+225);
  543.     YRes:=-(LongInt(YRes) SHL 8) DIV (ZRes+225);
  544.     Inc(ZRes,100);
  545. END;
  546.  
  547. PROCEDURE TransformPoints;
  548.  
  549. VAR
  550.     I:Word;
  551.     J,K:Byte;
  552.  
  553. BEGIN
  554.     SinU:=NormSin(U);
  555.     CosU:=NormCos(U);
  556.     SinV:=NormSin(V);
  557.     CosV:=NormCos(V);
  558.     SinW:=NormSin(W);
  559.     CosW:=NormCos(W);
  560.     ASM
  561.         { M (1,1) }
  562.         db $66
  563.         mov ax,word ptr cosv
  564.         db $66
  565.         imul word ptr cosw
  566.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  567.         db $66
  568.         mov word ptr m1,ax
  569.         { M (2,1) }
  570.         db $66
  571.         mov ax,word ptr cosv
  572.         db $66
  573.         imul word ptr sinw
  574.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  575.         db $66
  576.         mov word ptr m2,ax
  577.         { M (3,1) }
  578.         db $66
  579.         mov ax,word ptr sinv
  580.         db $66
  581.         neg ax
  582.         db $66
  583.         mov word ptr m3,ax
  584.         { Temp 1 }
  585.         db $66
  586.         mov ax,word ptr sinu
  587.         db $66
  588.         imul word ptr sinv
  589.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  590.         db $66
  591.         mov bx,ax
  592.         { Temp 2 }
  593.         db $66
  594.         mov ax,word ptr cosu
  595.         db $66
  596.         imul word ptr sinv
  597.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  598.         db $66
  599.         mov cx,ax
  600.         { M (2,1) }
  601.         db $66
  602.         mov ax,word ptr cosw
  603.         db $66
  604.         imul bx
  605.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  606.         db $66
  607.         mov si,ax
  608.         db $66
  609.         mov ax,word ptr cosu
  610.         db $66
  611.         imul word ptr sinw
  612.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  613.         db $66
  614.         sub si,ax
  615.         db $66
  616.         mov word ptr m4,si
  617.         { M (2,2) }
  618.         db $66
  619.         mov ax,word ptr sinw
  620.         db $66
  621.         imul bx
  622.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  623.         db $66
  624.         mov si,ax
  625.         db $66
  626.         mov ax,word ptr cosu
  627.         db $66
  628.         imul word ptr cosw
  629.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  630.         db $66
  631.         add si,ax
  632.         db $66
  633.         mov word ptr m5,si
  634.         { M (2,3) }
  635.         db $66
  636.         mov ax,word ptr sinu
  637.         db $66
  638.         imul word ptr cosv
  639.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  640.         db $66
  641.         mov word ptr m6,ax
  642.         { M (3,1) }
  643.         db $66
  644.         mov ax,word ptr cosw
  645.         db $66
  646.         imul cx
  647.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  648.         db $66
  649.         mov si,ax
  650.         db $66
  651.         mov ax,word ptr sinu
  652.         db $66
  653.         imul word ptr sinw
  654.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  655.         db $66
  656.         add si,ax
  657.         db $66
  658.         mov word ptr m7,si
  659.         { M (3,2) }
  660.         db $66
  661.         mov ax,word ptr sinw
  662.         db $66
  663.         imul cx
  664.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  665.         db $66
  666.         mov si,ax
  667.         db $66
  668.         mov ax,word ptr sinu
  669.         db $66
  670.         imul word ptr cosw
  671.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  672.         db $66
  673.         sub si,ax
  674.         db $66
  675.         mov word ptr m8,si
  676.         { M (3,3) }
  677.         db $66
  678.         mov ax,word ptr cosu
  679.         db $66
  680.         imul word ptr cosv
  681.         db $66,$0f,$ac,$d0,$10        { SHRD EAX,EDX,10h }
  682.         db $66
  683.         mov word ptr m9,ax
  684.     END;
  685.     FOR I:=1 TO NrPoints DO
  686.     BEGIN
  687.         XForm(Point[I,1],Point[I,2],Point[I,3]);
  688.         Dot[I,1]:=XRes+160;
  689.         Dot[I,2]:=YRes+100;
  690.         Dot[I,3]:=ZRes;
  691.     END;
  692. END;
  693.  
  694. PROCEDURE FillPoly(Count:Word; VAR A; Color:Byte);
  695.  
  696. BEGIN
  697. END;
  698.  
  699. PROCEDURE SetWriteMap(Map:Byte);
  700.  
  701. BEGIN
  702.     Port[$3C4]:=2;
  703.     Port[$3C5]:=Map;
  704. END;
  705.  
  706. PROCEDURE SetupTable;
  707.  
  708. VAR
  709.     I,J,K:Byte;
  710.  
  711. BEGIN
  712.     FOR K:=0 TO 3 DO
  713.         FOR J:=1 TO 124 DO
  714.             FOR I:=0 TO J SHL 1-1 DO
  715.             BEGIN
  716.                 SetWriteMap(1 SHL ((I+K) AND 3));
  717.                 Mem[$A800:K*$1000+((J+3) SHR 1)*((J+4) SHR 1)+(I+K) SHR 2]:=(I
  718. SHL 5) DIV J;
  719.                 Mem[$AC00:K*$1000+((J+3) SHR 1)*((J+4) SHR 1)+(I+K) SHR
  720. 2]:=63-((I SHL 5) DIV J);
  721.             END;
  722. END;
  723.  
  724. PROCEDURE XColorLine2(X1,X2,Y:Word; C1,C2:Byte);
  725.  
  726. BEGIN
  727.     ASM
  728.         mov ax,segment
  729.         mov es,ax
  730.         mov ax,y
  731.         xchg al,ah
  732.         mov di,ax
  733.         shr ax,2
  734.         add di,ax
  735.         shr di,2
  736.         mov dx,3c4h
  737.         mov al,2
  738.         out dx,al
  739.         inc dx
  740.         cld
  741.         mov bx,x1
  742.         mov al,byte ptr [bx+offset linetable1]
  743.         mov si,x2
  744.         mov ah,byte ptr [si+offset linetable2]
  745.         shr bx,2
  746.         shr si,2
  747.         mov cx,si
  748.         sub cx,bx
  749.         jcxz @1
  750.         dec cx
  751.         add di,bx
  752.         mov bh,ah
  753.         out dx,al
  754.         mov al,c1
  755.         shr al,1
  756.         stosb
  757.         jcxz @4
  758.         mov al,0fh
  759.         out dx,al
  760.         push bx
  761.         xor dx,dx
  762.         mov al,0
  763.         mov ah,c2
  764.         sub ah,c1
  765.         sbb dx,0
  766.         idiv cx
  767.         mov si,ax
  768.         mov dh,c1
  769.         mov dl,0
  770.         shr cx,1
  771.         jnc @2
  772.         add dx,si
  773.         mov ax,dx
  774.         shr ax,9
  775.         stosb
  776.         jcxz @5
  777.  
  778. @2: add dx,si
  779.         mov bx,dx
  780.         shr bx,1
  781.         add dx,si
  782.         mov ax,dx
  783.         shr ax,1
  784.         mov al,bh
  785.         stosw
  786.         loop @2
  787.  
  788. @5: pop bx
  789.  
  790. @4: mov al,bh
  791.         mov dx,3c5h
  792.         out dx,al
  793.         mov al,c2
  794.         shr al,1
  795.         stosb
  796.         jmp @3
  797.  
  798. @1: add di,bx
  799.         and al,ah
  800.         out dx,al
  801.         mov al,c1
  802.         add al,c2
  803.         rcr al,1
  804.         shr al,1
  805.         stosb
  806.  
  807. @3:
  808.  
  809.     END;
  810. END;
  811.  
  812. PROCEDURE SetWriteMode(M:Byte);
  813.  
  814. BEGIN
  815.     Port[$3CE]:=$05;
  816.     Port[$3CF]:=(Port[$3CF] AND $FC) OR (M AND 3);
  817. END;
  818.  
  819. PROCEDURE XColorLine(X1,X2,Y:Integer; C1,C2:Byte);
  820.  
  821. VAR
  822.     XD,CD,AdrSI,AdrDI:Word;
  823.     I,D,LineStart,StartByte,WhichMap,Map1,Map2,X1Ofs,XCount:Byte;
  824.  
  825. BEGIN
  826.     XD:=X2-X1;
  827.     CD:=Abs(C2-C1) SHL 1;
  828.     IF XD>=CD THEN
  829.     BEGIN
  830.         XColorLine2(X1,X2,Y,C1,C2);
  831.         Exit;
  832.     END;
  833.     IF XD=0 THEN Exit;
  834.     ASM
  835.         mov ax,xd
  836.         inc ax
  837.         xchg al,ah
  838.         xor dx,dx
  839.         div cd
  840.         inc ax
  841.         shr ax,1
  842.         mov d,al
  843.     END;
  844.     IF D>=125 THEN
  845.     BEGIN
  846.         XColorLine2(X1,X2,Y,C1,C2);
  847.         Exit;
  848.     END;
  849.     IF C1>C2 THEN
  850.     BEGIN
  851.         AdrSI:=$4000;
  852.         LineStart:=(D*(127-C1)) SHR 6;
  853.     END
  854.         ELSE
  855.     BEGIN
  856.         AdrSI:=0;
  857.         LineStart:=(D*C1) SHR 6;
  858.     END;
  859.     X1Ofs:=X1 AND 3;
  860.     WhichMap:=(X1Ofs-(LineStart AND 3)) AND 3;
  861.     XCount:=(XD+X1Ofs) SHR 2-1;
  862.     StartByte:=(LineStart+WhichMap) SHR 2;
  863.     AdrDI:=Y*80+X1 SHR 2;
  864.     Inc(AdrSI,WhichMap SHL 12+GTable[D]+StartByte);
  865.  
  866.     Map1:=(15 SHL X1Ofs) AND 15;
  867.     Map2:=2 SHL (X2 AND 3)-1;
  868.  
  869.     SetWriteMode(1);
  870.  
  871.     IF XCount=255 THEN
  872.     BEGIN
  873.         ASM
  874.             push ds
  875.             cld
  876.             mov si,adrsi
  877.             mov di,adrdi
  878.             mov al,2
  879.             mov ah,map1
  880.             and ah,map2
  881.             mov dx,3c4h
  882.             out dx,ax
  883.             mov ax,segment
  884.             mov es,ax
  885.             mov ax,$a800
  886.             mov ds,ax
  887.             movsb
  888.             pop ds
  889.         END;
  890.         SetWriteMode(0);
  891.         Exit;
  892.     END;
  893.     ASM
  894.         push ds
  895.         cld
  896.         mov dx,3c4h
  897.         mov al,2
  898.         out dx,al
  899.         inc dx
  900.         mov al,map1
  901.         out dx,al
  902.         mov si,adrsi
  903.         mov di,adrdi
  904.         mov cl,xcount
  905.         mov ch,0
  906.         mov bx,segment
  907.         mov es,bx
  908.         mov bx,$a800
  909.         mov ds,bx
  910.         movsb
  911.         jcxz @1
  912.         mov al,15
  913.         out dx,al
  914.         rep movsb   { <- 0.25 instructions/pixel }
  915. @1: mov al,map2
  916.         out dx,al
  917.         movsb
  918.         pop ds
  919.     END;
  920.     SetWriteMode(0);
  921. END;
  922.  
  923. PROCEDURE FillColorPoly(Count:Word; VAR A,C);
  924.  
  925. VAR
  926.     Point:ARRAY[0..9,0..1] OF Integer ABSOLUTE A;
  927.     Color:ARRAY[0..9] OF Byte ABSOLUTE C;
  928.     StartPoint,EndPoint,I,Y,DiffY:Word;
  929.     CurrLeftPoint,CurrRightPoint,NextLeftPoint,NextRightPoint,MinY,MaxY,
  930.     XD,YD,LX,RX,LX2,RX2,NextLeftY,NextRightY,YC,IncLeftColor,
  931.     IncRightColor:Integer;
  932.     LeftColor,RightColor:Integer;
  933.     IncLeftX,IncRightX,LeftX,RightX:LongInt;
  934.     LC,RC:Byte;
  935.  
  936. BEGIN
  937.     MinY:=Point[0,1];
  938.     MaxY:=Point[0,1];
  939.     StartPoint:=0;
  940.     EndPoint:=0;
  941.     FOR I:=1 TO Count-1 DO
  942.     BEGIN
  943.         IF Point[I,1]<MinY THEN
  944.         BEGIN
  945.             StartPoint:=I;
  946.             MinY:=Point[I,1];
  947.         END;
  948.         IF Point[I,1]>MaxY THEN
  949.         BEGIN
  950.             EndPoint:=I;
  951.             MaxY:=Point[I,1];
  952.         END;
  953.     END;
  954.     DiffY:=MaxY-MinY;
  955.     NextLeftPoint:=StartPoint;
  956.     NextRightPoint:=StartPoint;
  957.     NextLeftY:=Point[NextLeftPoint,1];
  958.     NextRightY:=Point[NextRightPoint,1];
  959.     FOR Y:=0 TO DiffY DO
  960.     BEGIN
  961.         IF Y<>DiffY THEN
  962.         BEGIN
  963.             IF MinY+Y=NextLeftY THEN
  964.             BEGIN
  965.                 LX2:=32767;
  966.                 REPEAT
  967.                     CurrLeftPoint:=NextLeftPoint;
  968.                     NextLeftPoint:=(CurrLeftPoint+Count-1) MOD Count;
  969.                     XD:=(Point[NextLeftPoint,0]-Point[CurrLeftPoint,0]);
  970.                     IF Point[CurrLeftPoint,0]<LX2 THEN
  971.                     LX2:=Point[CurrLeftPoint,0];
  972.                     YD:=(Point[NextLeftPoint,1]-Point[CurrLeftPoint,1]);
  973.                 UNTIL YD<>0;
  974.                 LeftColor:=Color[CurrLeftPoint];
  975.                 YC:=Color[NextLeftPoint]-LeftColor;
  976.                 LeftColor:=LeftColor SHL 8;
  977.                 ASM
  978.                     mov ax,yc
  979.                     xchg al,ah
  980.                     cwd
  981.                     idiv yd
  982.                     mov incleftcolor,ax
  983.                 END;
  984.                 ASM
  985.                     db $66
  986.                     xor ax,ax
  987.                     mov ax,xd
  988.                     db $66
  989.                     shl ax,16
  990.                     db $66
  991.                     cwd
  992.                     db $66
  993.                     xor bx,bx
  994.                     mov bx,yd
  995.                     db $66
  996.                     idiv bx
  997.                     db $66
  998.                     mov word ptr incleftx,ax
  999.                 END;
  1000.                 LeftX:=LongInt(Point[CurrLeftPoint,0]) SHL 16;
  1001.                 ASM
  1002.                     db $66
  1003.                     mov ax,word ptr incleftx
  1004.                     db $66
  1005.                     sub ax,0000h
  1006.                     dw 0001h
  1007.                     db $66
  1008.                     sar ax,1
  1009.                     db $66
  1010.                     sub word ptr leftx,ax
  1011.                 END;
  1012.                 NextLeftY:=Point[NextLeftPoint,1];
  1013.             END;
  1014.             IF MinY+Y=NextRightY THEN
  1015.             BEGIN
  1016.                 RX2:=-32768;
  1017.                 REPEAT
  1018.                     CurrRightPoint:=NextRightPoint;
  1019.                     NextRightPoint:=(CurrRightPoint+1) MOD Count;
  1020.                     XD:=(Point[NextRightPoint,0]-Point[CurrRightPoint,0]);
  1021.                     IF Point[CurrRightPoint,0]>RX2 THEN
  1022. RX2:=Point[CurrRightPoint,0];
  1023.                     YD:=(Point[NextRightPoint,1]-Point[CurrRightPoint,1]);
  1024.                 UNTIL YD<>0;
  1025.                 RightColor:=Color[CurrRightPoint];
  1026.                 YC:=Color[NextRightPoint]-RightColor;
  1027.                 RightColor:=RightColor SHL 8;
  1028.                 ASM
  1029.                     mov ax,yc
  1030.                     xchg al,ah
  1031.                     cwd
  1032.                     idiv yd
  1033.                     mov incrightcolor,ax
  1034.                 END;
  1035.                 ASM
  1036.                     db $66
  1037.                     xor ax,ax
  1038.                     mov ax,xd
  1039.                     db $66
  1040.                     shl ax,16
  1041.                     db $66
  1042.                     cwd
  1043.                     db $66
  1044.                     xor bx,bx
  1045.                     mov bx,yd
  1046.                     db $66
  1047.                     idiv bx
  1048.                     db $66
  1049.                     mov word ptr incrightx,ax
  1050.                 END;
  1051.                 RightX:=LongInt(Point[CurrRightPoint,0]) SHL 16;
  1052.                 ASM
  1053.                     db $66
  1054.                     mov ax,word ptr incrightx
  1055.                     db $66
  1056.                     sub ax,0000h
  1057.                     dw 0001h
  1058.                     db $66
  1059.                     sar ax,1
  1060.                     db $66
  1061.                     sub word ptr rightx,ax
  1062.                 END;
  1063.                 NextRightY:=Point[NextRightPoint,1];
  1064.             END;
  1065.         END
  1066.          ELSE
  1067.         ASM
  1068.             db $66
  1069.             sar word ptr incleftx,1
  1070.             db $66
  1071.             sar word ptr incrightx,1
  1072.         END;
  1073.         Inc(LeftColor,IncLeftColor);
  1074.         IF LeftColor<0 THEN LC:=0
  1075.         ELSE
  1076.         IF LeftColor>30000 THEN LC:=127
  1077.          ELSE LC:=LeftColor SHR 7;
  1078.         Inc(RightColor,IncRightColor);
  1079.         IF RightColor<0 THEN RC:=0
  1080.          ELSE
  1081.         IF RightColor>30000 THEN RC:=127
  1082.          ELSE RC:=RightColor SHR 7;
  1083.         ASM
  1084.             db $66
  1085.             mov ax,word ptr leftx
  1086.             db $66
  1087.             add ax,word ptr incleftx
  1088.             db $66
  1089.             mov word ptr leftx,ax
  1090.             db $66
  1091.             sar ax,16
  1092.  
  1093.             db $66
  1094.             mov bx,word ptr rightx
  1095.             db $66
  1096.             add bx,word ptr incrightx
  1097.             db $66
  1098.             mov word ptr rightx,bx
  1099.             db $66
  1100.             sar bx,16
  1101.  
  1102.             cmp ax,bx
  1103.             jng @1
  1104.             xchg ax,bx
  1105.             mov dl,lc
  1106.             xchg dl,rc
  1107.             xchg lc,dl
  1108.  
  1109. @1:   mov cx,319
  1110.             or ax,ax
  1111.             jnl @2
  1112.             xor ax,ax
  1113.             or bx,bx
  1114.             jng @4
  1115.  
  1116. @2:   cmp bx,cx
  1117.             jng @3
  1118.             mov bx,cx
  1119.             cmp ax,cx
  1120.             jnl @4
  1121.  
  1122. @3:   mov lx,ax
  1123.             mov rx,bx
  1124.             mov dx,miny
  1125.             add dx,y
  1126.             or dx,dx
  1127.             jl @4
  1128.             cmp dx,199
  1129.             jg @4
  1130.             push ax
  1131.             push bx
  1132.             push dx
  1133.             mov al,lc
  1134.             push ax
  1135.             mov al,rc
  1136.             push ax
  1137.             call xcolorline
  1138.  
  1139. @4:
  1140.         END;
  1141.     END;
  1142. END;
  1143.  
  1144. PROCEDURE FillPolygon(Count:Word; VAR A; Color:Byte);
  1145.  
  1146. VAR
  1147.     Coord:ARRAY[0..3,0..1] OF Integer ABSOLUTE A;
  1148.     X1,X2,Y,Y1,Y2,MinY,MaxY,Divisor:Integer;
  1149.     I,Start,Left,Right:Word;
  1150.     LeftX,RightX,LeftInc,RightInc:LongInt;
  1151.  
  1152. BEGIN
  1153. END;
  1154.  
  1155. PROCEDURE FillPhongPolygon(Count:Word; VAR A; VAR B);
  1156.  
  1157. BEGIN
  1158. END;
  1159.  
  1160. PROCEDURE FillPhongTexturePoly(Count:Word; VAR A; VAR B);
  1161.  
  1162. BEGIN
  1163. END;
  1164.  
  1165. PROCEDURE FillTexturePoly(Count:Word; VAR A);
  1166.  
  1167. BEGIN
  1168. END;
  1169.  
  1170. PROCEDURE PerspectiveTexturePoly(Count:Word; VAR A);
  1171.  
  1172. BEGIN
  1173. END;
  1174.  
  1175. PROCEDURE FillTinyTexturePoly(Count:Word; VAR A);
  1176.  
  1177. BEGIN
  1178. END;
  1179.  
  1180. FUNCTION GetLight(ObjNr,Nr:Integer):Integer;
  1181.  
  1182. VAR
  1183.     VAX,VAY,VAZ,VBX,VBY,VBZ:Integer;
  1184.     NX,NY,NZ:LongInt;
  1185.     P1,P2,P3,P11,P12,P13:Integer;
  1186.     Quadrat:Integer;
  1187.     BEGIN
  1188.         WITH Objects[ObjNr].Face[Nr] DO
  1189.         BEGIN
  1190.             P1:=P[1];
  1191.             P2:=P[2];
  1192.             P3:=P[3];
  1193.             P11:=Dot[P1,1];
  1194.             P12:=Dot[P1,2];
  1195.             P13:=Dot[P1,3];
  1196.             VAX:=Dot[P2,1]-P11;
  1197.             VAY:=Dot[P2,2]-P12;
  1198.             VAZ:=Dot[P2,3]-P13;
  1199.             VBX:=Dot[P3,1]-P11;
  1200.             VBY:=Dot[P3,2]-P12;
  1201.             VBZ:=Dot[P3,3]-P13;
  1202.             NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY;
  1203.             NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ;
  1204.             NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX;
  1205.             ASM
  1206.                 db $66
  1207.                 mov ax,word ptr nx
  1208.                 db $66
  1209.                 cbw
  1210.                 db $66
  1211.                 mov cx,ax
  1212.                 db $66
  1213.                 imul cx
  1214.                 db $66
  1215.                 mov bx,ax
  1216.  
  1217.                 db $66
  1218.                 mov ax,word ptr ny
  1219.                 db $66
  1220.                 cbw
  1221.                 db $66
  1222.                 mov cx,ax
  1223.                 db $66
  1224.                 imul cx
  1225.                 db $66
  1226.                 add bx,ax
  1227.  
  1228.                 db $66
  1229.                 mov ax,word ptr nz
  1230.                 db $66
  1231.                 cbw
  1232.                 db $66
  1233.                 mov cx,ax
  1234.                 db $66
  1235.                 imul cx
  1236.                 db $66
  1237.                 add bx,ax
  1238.                 db $66
  1239.                 shr bx,12
  1240.                 inc bx
  1241.                 db $66
  1242.                 div bx
  1243.                 cmp ax,63*63
  1244.                 jl @1
  1245.                 mov ax,63*63
  1246.  
  1247. @1:     mov word ptr quadrat,ax
  1248.             END;
  1249.             IF NZ<0 THEN GetLight:=-SqrtTable[Quadrat]
  1250.              ELSE GetLight:=SqrtTable[Quadrat];
  1251.  
  1252.         END;
  1253. END;
  1254.  
  1255.  
  1256. FUNCTION Visible(ObjNr,Nr:Integer):Integer;
  1257.  
  1258. VAR
  1259.     VAX,VAY,VAZ,VBX,VBY,VBZ:Integer;
  1260.     NX,NY,NZ:LongInt;
  1261.     P1,P2,P3,P11,P12,P13:Integer;
  1262.     Quadrat:Integer;
  1263.  
  1264. BEGIN
  1265.     WITH Objects[ObjNr].Face[Nr] DO
  1266.     BEGIN
  1267.         P1:=P[1];
  1268.         P2:=P[2];
  1269.         P3:=P[3];
  1270.         P11:=Dot[P1,1];
  1271.         P12:=Dot[P1,2];
  1272.         P13:=Dot[P1,3];
  1273.         VAX:=Dot[P2,1]-P11;
  1274.         VAY:=Dot[P2,2]-P12;
  1275.         VBX:=Dot[P3,1]-P11;
  1276.         VBY:=Dot[P3,2]-P12;
  1277.         NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX;
  1278.         IF NZ<0 THEN
  1279.         BEGIN
  1280.             Visible:=-1;
  1281.             Exit;
  1282.         END;
  1283.         VAZ:=Dot[P2,3]-P13;
  1284.         VBZ:=Dot[P3,3]-P13;
  1285.         NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY;
  1286.         NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ;
  1287.         ASM
  1288.             db $66
  1289.             mov ax,word ptr nx
  1290.             db $66
  1291.             cbw
  1292.             db $66
  1293.             mov cx,ax
  1294.             db $66
  1295.             imul cx
  1296.             db $66
  1297.             mov bx,ax
  1298.  
  1299.             db $66
  1300.             mov ax,word ptr ny
  1301.             db $66
  1302.             cbw
  1303.             db $66
  1304.             mov cx,ax
  1305.             db $66
  1306.             imul cx
  1307.             db $66
  1308.             add bx,ax
  1309.  
  1310.             db $66
  1311.             mov ax,word ptr nz
  1312.             db $66
  1313.             cbw
  1314.             db $66
  1315.             mov cx,ax
  1316.             db $66
  1317.             imul cx
  1318.             db $66
  1319.             add bx,ax
  1320.             db $66
  1321.             shr bx,12
  1322.             inc bx
  1323.             db $66
  1324.             div bx
  1325.             cmp ax,63*63
  1326.             jl @1
  1327.             mov ax,63*63
  1328.  
  1329. @1:   mov word ptr quadrat,ax
  1330.         END;
  1331.         Visible:=SqrtTable[Quadrat];
  1332.     END;
  1333. END;
  1334.  
  1335. PROCEDURE GetVec(VAR Vec:VecType; ObjNr,Nr:Integer);
  1336.  
  1337. VAR
  1338.     VAX,VAY,VAZ,VBX,VBY,VBZ:Integer;
  1339.     NX,NY,NZ:LongInt;
  1340.     P1,P2,P3,P11,P12,P13:Integer;
  1341.  
  1342. BEGIN
  1343.     WITH Objects[ObjNr].Face[Nr] DO
  1344.     BEGIN
  1345.         P1:=P[1];
  1346.         P2:=P[2];
  1347.         P3:=P[3];
  1348.         P11:=Dot[P1,1];
  1349.         P12:=Dot[P1,2];
  1350.         P13:=Dot[P1,3];
  1351.         VAX:=Dot[P2,1]-P11;
  1352.         VAY:=Dot[P2,2]-P12;
  1353.         VAZ:=Dot[P2,3]-P13;
  1354.         VBX:=Dot[P3,1]-P11;
  1355.         VBY:=Dot[P3,2]-P12;
  1356.         VBZ:=Dot[P3,3]-P13;
  1357.         NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY;
  1358.         NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ;
  1359.         NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX;
  1360.         Vec[0]:=Integer(NX);
  1361.         Vec[1]:=Integer(NY);
  1362.         Vec[2]:=Integer(NZ);
  1363.     END;
  1364. END;
  1365.  
  1366. PROCEDURE DrawFace(ObjNr,Nr:Integer);
  1367.  
  1368. VAR
  1369.     I,J,K,Color:Byte;
  1370.     PhongVec:ARRAY[1..6] OF VecType;
  1371.     PhongZ:ARRAY[1..6] OF Integer;
  1372.     PX:ARRAY[1..6,1..2] OF Integer;
  1373.     P3X:ARRAY[1..6,1..3] OF Integer;
  1374.     CX:ARRAY[1..6] OF Byte;
  1375.     L,MinX,MaxX,MinY,MaxY:Integer;
  1376.     Quotient:LongInt;
  1377.  
  1378. BEGIN
  1379.     WITH Objects[ObjNr].Face[Nr] DO
  1380.     BEGIN
  1381.         IF NOT Gouraud THEN Light:=Visible(ObjNr,Nr);
  1382.         IF Light<0 THEN Exit;
  1383.         IF Lighted THEN Color:=Light
  1384.             ELSE Color:=Byte(Nr);
  1385.         IF FaceTyp>=3 THEN
  1386.         BEGIN
  1387.             MinX:=32767;
  1388.             MinY:=32767;
  1389.             MaxX:=-32767;
  1390.             MaxY:=-32767;
  1391.             IF PerspectiveTexture THEN
  1392.             BEGIN
  1393.                 FOR J:=1 TO FaceTyp DO
  1394.                 BEGIN
  1395.                     P3X[J,1]:=Dot[P[J],1];
  1396.                     P3X[J,2]:=Dot[P[J],2];
  1397.                     P3X[J,3]:=Dot[P[J],3];
  1398.                     IF P3X[J,1]<MinX THEN MinX:=P3X[J,1];
  1399.                     IF P3X[J,1]>MaxX THEN MaxX:=P3X[J,1];
  1400.                     IF P3X[J,2]<MinY THEN MinY:=P3X[J,2];
  1401.                     IF P3X[J,2]>MaxY THEN MaxY:=P3X[J,2];
  1402.                 END;
  1403.                 IF (MinX>319) OR (MinY>199) OR (MaxX<0) OR (MaxY<0) THEN Exit;
  1404.                 PerspectiveTexturePoly(FaceTyp,P3X);
  1405.             END
  1406.              ELSE
  1407.             BEGIN
  1408.                 FOR J:=1 TO FaceTyp DO
  1409.                 BEGIN
  1410.                     PX[J,1]:=Dot[P[J],1];
  1411.                     PX[J,2]:=Dot[P[J],2];
  1412.                     IF PX[J,1]<MinX THEN MinX:=PX[J,1];
  1413.                     IF PX[J,1]>MaxX THEN MaxX:=PX[J,1];
  1414.                     IF PX[J,2]<MinY THEN MinY:=PX[J,2];
  1415.                     IF PX[J,2]>MaxY THEN MaxY:=PX[J,2];
  1416.                     IF Phong OR PhongTexture THEN PhongZ[J]:=EdgeNorm[P[J]]
  1417.                      ELSE
  1418.                     IF Gouraud THEN
  1419.                     BEGIN
  1420.                         L:=EdgeLight[P[J]];
  1421.                         IF L<0 THEN L:=0
  1422.                          ELSE
  1423.                         IF L>63 THEN L:=63;
  1424.                         CX[J]:=L;
  1425.                     END;
  1426.                 END;
  1427.                 IF (MinX>319) OR (MinY>199) OR (MaxX<0) OR (MaxY<0) THEN Exit;
  1428.                 IF Phong THEN FillPhongPolygon(FaceTyp,PX,PhongZ)
  1429.                  ELSE
  1430.                 IF Gouraud THEN FillColorPoly(FaceTyp,PX,CX)
  1431.                  ELSE
  1432.                 IF Texture THEN FillTexturePoly(FaceTyp,PX)
  1433.                  ELSE
  1434.                 IF TinyTexture THEN FillTinyTexturePoly(FaceTyp,PX)
  1435.                  ELSE
  1436.                 IF PhongTexture THEN FillPhongTexturePoly(FaceTyp,PX,PhongZ)
  1437.                  ELSE FillPolygon(FaceTyp,PX,Color);
  1438.             END;
  1439.         END;
  1440.     END;
  1441. END;
  1442.  
  1443. PROCEDURE SortFaces(ObjNr,Count:Integer);
  1444.  
  1445. VAR
  1446.     I:Word;
  1447.  
  1448. PROCEDURE Sort(L,R:Integer);
  1449.  
  1450. VAR
  1451.     I,J,X,Y,XR:Integer;
  1452.  
  1453. BEGIN
  1454.     WITH Objects[ObjNr] DO
  1455.     BEGIN
  1456.         I:=L;
  1457.         J:=R;
  1458.         XR:=Face[SortedFace[(L+R) SHR 1]].FarZ;
  1459.         REPEAT
  1460.             WHILE Face[SortedFace[I]].FarZ>XR DO Inc(I);
  1461.             WHILE XR>Face[SortedFace[J]].FarZ DO Dec(J);
  1462.             IF I<=J THEN
  1463.             BEGIN
  1464.                 Y:=SortedFace[I];
  1465.                 SortedFace[I]:=SortedFace[J];
  1466.                 SortedFace[J]:=Y;
  1467.                 Inc(I);
  1468.                 Dec(J);
  1469.             END;
  1470.         UNTIL I>J;
  1471.         IF L<J THEN Sort(L,J);
  1472.         IF L<R THEN Sort(I,R);
  1473.     END;
  1474. END;
  1475.  
  1476. BEGIN
  1477.     Sort(0,Count-1);
  1478. END;
  1479.  
  1480. PROCEDURE DrawObject(Nr:Integer);
  1481.  
  1482. VAR
  1483.     I,J:Integer;
  1484.  
  1485. BEGIN
  1486.     WITH Objects[Nr] DO
  1487.     BEGIN
  1488.         FOR I:=1 TO NrFaces DO
  1489.         BEGIN
  1490.             SortedFace[I-1]:=I;
  1491.             WITH Face[I] DO
  1492.             BEGIN
  1493.                 FarZ:=Dot[P[1],3];
  1494.                 FOR J:=2 TO FaceTyp DO
  1495.                     IF Dot[P[J],3]<FarZ THEN
  1496.                         FarZ:=Dot[P[J],3];
  1497.             END;
  1498.         END;
  1499.         SortFaces(Nr,NrFaces);
  1500.         FOR I:=1 TO NrFaces DO
  1501.         DrawFace(Nr,SortedFace[I-1]);
  1502.     END;
  1503. END;
  1504.  
  1505. PROCEDURE LightFace(ObjNr,Nr:Integer);
  1506.  
  1507. VAR
  1508.     J:Byte;
  1509.  
  1510. BEGIN
  1511.     WITH Objects[ObjNr].Face[Nr] DO
  1512.     BEGIN
  1513.         Light:=GetLight(ObjNr,Nr);
  1514.         FOR J:=1 TO FaceTyp DO
  1515.         BEGIN
  1516.             Inc(EdgeLight[P[J]],Light);
  1517.             Inc(EdgeLightCount[P[J]]);
  1518.         END;
  1519.     END;
  1520. END;
  1521.  
  1522. PROCEDURE LightObject(Nr:Integer);
  1523.  
  1524. VAR
  1525.     I:Integer;
  1526.  
  1527. BEGIN
  1528.     WITH Objects[Nr] DO
  1529.         FOR I:=1 TO NrFaces DO LightFace(Nr,I);
  1530. END;
  1531.  
  1532. PROCEDURE PhongLightFace(ObjNr,Nr:Integer);
  1533.  
  1534. VAR
  1535.     I:Word;
  1536.     Vector:VecType;
  1537.     VAX,VAY,VAZ,VBX,VBY,VBZ:Integer;
  1538.     NX,NY,NZ:LongInt;
  1539.     P1,P2,P3,P11,P12,P13:Integer;
  1540.  
  1541. BEGIN
  1542.     WITH Objects[ObjNr].Face[Nr] DO
  1543.     BEGIN
  1544.         P1:=P[1];
  1545.         P2:=P[2];
  1546.         P3:=P[3];
  1547.         P11:=Dot[P1,1];
  1548.         P12:=Dot[P1,2];
  1549.         P13:=Dot[P1,3];
  1550.         VAX:=Dot[P2,1]-P11;
  1551.         VAY:=Dot[P2,2]-P12;
  1552.         VAZ:=Dot[P2,3]-P13;
  1553.         VBX:=Dot[P3,1]-P11;
  1554.         VBY:=Dot[P3,2]-P12;
  1555.         VBZ:=Dot[P3,3]-P13;
  1556.         NX:=LongInt(VAY)*VBZ-LongInt(VAZ)*VBY;
  1557.         NY:=LongInt(VAZ)*VBX-LongInt(VAX)*VBZ;
  1558.         NZ:=LongInt(VAX)*VBY-LongInt(VAY)*VBX;
  1559.         FOR I:=1 TO FaceTyp DO
  1560.         BEGIN
  1561.             P1:=P[I];
  1562.             Inc(EdgeVec[P1,0],Integer(NX));
  1563.             Inc(EdgeVec[P1,1],Integer(NY));
  1564.             Inc(EdgeVec[P1,2],Integer(NZ));
  1565.         END;
  1566.     END;
  1567. END;
  1568.  
  1569. PROCEDURE PhongLightObject(Nr:Integer);
  1570.  
  1571. VAR
  1572.     I:Integer;
  1573.  
  1574. BEGIN
  1575.     WITH Objects[Nr] DO
  1576.         FOR I:=1 TO NrFaces DO
  1577.             PhongLightFace(Nr,I);
  1578. END;
  1579.  
  1580.  
  1581. PROCEDURE SetStart(S:Word);
  1582.  
  1583. BEGIN
  1584.     ASM
  1585.         mov bx,s
  1586.         mov dx,$3d4
  1587.         mov al,$c
  1588.         mov ah,bh
  1589.         out dx,ax
  1590.         inc ax
  1591.         mov ah,bl
  1592.         out dx,ax
  1593.     END;
  1594. END;
  1595.  
  1596.  
  1597. PROCEDURE VerticalRetrace;
  1598.  
  1599. BEGIN
  1600.     ASM
  1601.         mov dx,3dah
  1602. @1: in al,dx
  1603.         test al,8
  1604.         jz @1
  1605. @2: in al,dx
  1606.         test al,8
  1607.         jnz @2
  1608.     END;
  1609. END;
  1610.  
  1611. PROCEDURE FlipPage;
  1612.  
  1613. BEGIN
  1614.     IF NOT ModeX THEN
  1615.     BEGIN
  1616.         Segment:=Seg(VirtualScreen^);
  1617.         SetStart(0);
  1618.     END
  1619.      ELSE
  1620.     IF Flip THEN
  1621.     BEGIN
  1622.         Segment:=$A400;
  1623.         SetStart($0000);
  1624.     END
  1625.      ELSE
  1626.     BEGIN
  1627.         Segment:=$A000;
  1628.         SetStart($4000);
  1629.     END;
  1630.     IF NOT NoVert AND NOT Phong THEN VerticalRetrace;
  1631.     Flip:=NOT Flip;
  1632. END;
  1633.  
  1634. PROCEDURE ClearScreen;
  1635.  
  1636. VAR
  1637.     Count:Word;
  1638.  
  1639. BEGIN
  1640.     IF ModeX THEN
  1641.     BEGIN
  1642.         SetWriteMap(15);
  1643.         Count:=4000;
  1644.     END
  1645.      ELSE Count:=16000;
  1646.     ASM
  1647.         mov ax,segment
  1648.         mov es,ax
  1649.         xor di,di
  1650.         {$IFDEF GLENZ}
  1651.         mov cx,2000
  1652.         mov dx,3ceh
  1653.         mov ax,0003h
  1654.         out dx,ax
  1655.         {$ELSE}
  1656.         mov cx,count
  1657.         {$ENDIF}
  1658.         cld
  1659.         db $66
  1660.         xor ax,ax
  1661.         rep
  1662.         db $66
  1663.         stosw
  1664.         {$IFDEF GLENZ}
  1665.         mov dx,3ceh
  1666.         mov ax,1003h
  1667.         out dx,ax
  1668.         {$ENDIF}
  1669.     END;
  1670. END;
  1671.  
  1672. PROCEDURE TransferScreen; ASSEMBLER;
  1673.  
  1674. ASM
  1675.     push ds
  1676.     lds si,virtualscreen
  1677.     mov ax,0a000h
  1678.     mov es,ax
  1679.     xor di,di
  1680.     mov cx,16000
  1681.     db 66h
  1682.     rep movsw
  1683.     pop ds
  1684. END;
  1685.  
  1686.  
  1687. PROCEDURE BuildDivTable;
  1688.  
  1689. VAR
  1690.     I,Result:Word;
  1691.  
  1692. BEGIN
  1693. END;
  1694.  
  1695. PROCEDURE MCGAOn;
  1696.  
  1697. BEGIN
  1698.     ASM
  1699.         mov ax,$13
  1700.         int $10
  1701.     END;
  1702. END;
  1703.  
  1704.  
  1705. PROCEDURE SwitchOff; ASSEMBLER;
  1706.  
  1707. ASM
  1708.     mov dx,$3c4
  1709.     mov al,1
  1710.     out dx,al
  1711.     inc dx
  1712.     in al,dx
  1713.     or al,$20
  1714.     out dx,al
  1715. END;
  1716.  
  1717. PROCEDURE SwitchOn; ASSEMBLER;
  1718.  
  1719. ASM
  1720.     mov dx,$3c4
  1721.     mov al,1
  1722.     out dx,al
  1723.     inc dx
  1724.     in al,dx
  1725.     and al,$df
  1726.     out dx,al
  1727. END;
  1728.  
  1729. PROCEDURE Unchain;
  1730.  
  1731. BEGIN
  1732.     PortW[$3C4]:=$0604;
  1733.     PortW[$3D4]:=$0014;
  1734.     PortW[$3D4]:=$E317;
  1735.     PortW[$3C4]:=$0F02;
  1736. END;
  1737.  
  1738. PROCEDURE Init13X;
  1739.  
  1740. BEGIN
  1741.     MCGAOn;
  1742.     SwitchOff;
  1743.     Unchain;
  1744.     ClearScreen;
  1745.     SwitchOn;
  1746. END;
  1747.  
  1748. PROCEDURE SetColor(Nr,R,G,B:Byte);
  1749.  
  1750. BEGIN
  1751.     Port[$3C8]:=Nr;
  1752.     Port[$3C9]:=R;
  1753.     Port[$3C9]:=G;
  1754.     Port[$3C9]:=B;
  1755. END;
  1756.  
  1757. PROCEDURE GetAdjMem(VAR P:Pointer; Size:Word);
  1758.  
  1759. BEGIN
  1760.     IF Word(Size+15)>Size THEN
  1761.         Inc(Size,15)
  1762.     ELSE Size:=65535;
  1763.     GetMem(P,Size);
  1764.     IF Ofs(P^)<>0 THEN P:=Ptr(Seg(P^)+1,0);
  1765. END;
  1766.  
  1767. PROCEDURE Init3D;
  1768.  
  1769. VAR
  1770.     F:File;
  1771.     Rl:Real;
  1772.     Header:RECORD
  1773.         Dummy:ARRAY[0..8] OF Byte;
  1774.         XSize,YSize:Word;
  1775.         Dummy2:ARRAY[13..31] OF Byte;
  1776.     END;
  1777.     SpotStart:Byte;
  1778.     I,J:Word;
  1779.  
  1780. BEGIN
  1781.     FOR I:=0 TO 319 DO
  1782.     BEGIN
  1783.         LineTable1[I]:=(15 SHL (I AND 3)) AND 15;
  1784.         LineTable2[I]:=(2 SHL (I AND 3))-1;
  1785.     END;
  1786.     FOR I:=0 TO 127 DO
  1787.         GTable[I]:=((I+3) SHR 1)*((I+4) SHR 1);
  1788.     NrPoints:=0;
  1789.     ReadObject(ParamStr(1));
  1790.     IF ParamCount>1 THEN
  1791.         Val(ParamStr(2),Rl,Error);
  1792.     NoVert:=ParamStr(3)='n';
  1793.     Lighted:=ParamStr(4)='l';
  1794.     Gouraud:=ParamStr(4)='g';
  1795.     Phong:=ParamStr(4)='p';
  1796.     Texture:=ParamStr(4)='t';
  1797.     TinyTexture:=ParamStr(4)='tt';
  1798.     PhongTexture:=ParamStr(4)='pt';
  1799.     PerspectiveTexture:=ParamStr(4)='ps';
  1800.     ModeX:=NOT (Phong OR Texture OR TinyTexture OR PhongTexture OR
  1801. PerspectiveTexture);
  1802.     IF Error=0 THEN
  1803.     BEGIN
  1804.         ScalX:=Round(ScalX*Rl);
  1805.         ScalY:=Round(ScalY*Rl);
  1806.         ScalZ:=Round(ScalZ*Rl);
  1807.     END
  1808.      ELSE
  1809.     BEGIN
  1810.         ScalX:=65536;
  1811.         ScalY:=65536;
  1812.         ScalZ:=65536;
  1813.     END;
  1814.     FOR I:=0 TO 900 DO
  1815.         Sinus[I]:=Round(Sin(I/1800*Pi)*65535);
  1816.     Segment:=$A000;
  1817.  
  1818. {$IFDEF GLENZ}
  1819.     ASM
  1820.         mov ax,$d
  1821.         int $10
  1822.     END;
  1823.     ASM
  1824.         mov dx,3ceh
  1825.         mov ax,1003h
  1826.         out dx,ax
  1827.     END;
  1828.     SetColor(0,0,0,0);
  1829.     SetColor(1,63,0,0);
  1830.     SetColor(2,0,63,0);
  1831.     SetColor(3,63,63,0);
  1832.     SetColor(4,0,0,63);
  1833.     SetColor(5,63,0,63);
  1834.     SetColor(6,0,63,63);
  1835.     SetColor(7,63,63,63);
  1836.     {$ELSE}
  1837.     IF ModeX THEN Init13X
  1838.      ELSE
  1839.     BEGIN
  1840.         MCGAOn;
  1841.         GetAdjMem(VirtualScreen,64000);
  1842.     END;
  1843. {$ENDIF}
  1844.     IF Gouraud THEN SetupTable;
  1845.     IF Lighted OR Gouraud THEN
  1846.         FOR I:=0 TO 63 DO
  1847.             SetColor(I,0,I,0)
  1848.      ELSE
  1849.     IF Phong OR PhongTexture THEN
  1850.     BEGIN
  1851.     END;
  1852.     J:=0;
  1853.     FillChar(Dummy,4096,0);
  1854.     FOR I:=0 TO 4095 DO
  1855.     BEGIN
  1856.         IF (J+1)*(J+1)=I THEN Inc(J);
  1857.         SqrtTable[I]:=J;
  1858.     END;
  1859.     U:=0;
  1860.     V:=0;
  1861.     W:=0;
  1862.     XOfs:=0;
  1863.     YOfs:=0;
  1864.     ZOfs:=0;
  1865.     J:=0;
  1866.     FlipPage;
  1867.  
  1868. {$IFDEF TIMER}
  1869.     Port[$43]:=$34;
  1870.     Port[$40]:=0;
  1871.     Port[$40]:=66;
  1872. {$ENDIF}
  1873.     LX:=1;
  1874.     LY:=1;
  1875.     LZ:=1;
  1876.     LNorm:=LongInt(LX)*LX+LongInt(LY)*LY+LongInt(LZ)*LZ;
  1877. END;
  1878.  
  1879. PROCEDURE TextMode; ASSEMBLER;
  1880.  
  1881. ASM
  1882.     mov ax,3
  1883.     int 10h
  1884. END;
  1885.  
  1886.  
  1887. PROCEDURE StartTimer;
  1888.  
  1889. BEGIN
  1890.     Zeit:=Ticker;
  1891. END;
  1892.  
  1893.  
  1894. PROCEDURE StopTimer;
  1895.  
  1896. BEGIN
  1897.     Zeit:=Ticker-Zeit;
  1898. END;
  1899.  
  1900.  
  1901. BEGIN
  1902.     IF ParamCount=0 THEN
  1903.     BEGIN
  1904.         WriteLn('Syntax: 3DOBJ2 model size retrace lightshading-type');
  1905.         WriteLn('        where model.xyz is a coordinate file, size a real
  1906. number,');
  1907.         WriteLn('        i.e. 1 around, retrace either ''n'' for no Vertical');
  1908.         WriteLn('        Retrace Checking, or any other char for doing it,
  1909. light');
  1910.         WriteLn('        can be either n (normal), l (lightshaded), g
  1911. (gouraud),');
  1912.         WriteLn('        p (phong), t (texture), tt (tiny texture), pt
  1913. (phongtexture)');
  1914.         WriteLn('        or ps (perspective texture).');
  1915.         Halt;
  1916.     END;
  1917.     Init3D;
  1918.     FOR I:=0 TO 127 DO Key[I]:=FALSE;
  1919.  
  1920.     GetIntVec($09,SaveInt09);
  1921.     SetIntVec($09,@NewInt09);
  1922.     StartTimer;
  1923.     Phase:=0;
  1924.     U:=410;
  1925.     V:=758;
  1926.     W:=0;
  1927.     REPEAT
  1928.         LastTimer:=Timer;
  1929.         FlipPage;
  1930.         {$IFDEF MEASURE}
  1931.          SetColor(0,63,63,63);
  1932.         {$ENDIF}
  1933.          Inc(J);
  1934.          TransformPoints;
  1935.          ClearScreen;
  1936.          IF Phong OR PhongTexture THEN
  1937.          BEGIN
  1938.              FillChar(EdgeVec,SizeOf(EdgeVec),0);
  1939.              FOR I:=1 TO ObjectCount DO PhongLightObject(I);
  1940.              FOR I:=1 TO NrPoints DO
  1941.              BEGIN
  1942.                  Quotient:=IntSqrt(Sqr(LongInt(EdgeVec[I,0]))+
  1943.                  Sqr(LongInt(EdgeVec[I,1]))+Sqr(LongInt(EdgeVec[I,2])));
  1944.                  IF Quotient=0 THEN Inc(Quotient);
  1945.                  EdgeNorm[I]:=(LongInt(EdgeVec[I,2]) SHL 14) DIV Quotient;
  1946.              END;
  1947.          END
  1948.              ELSE
  1949.                  IF Gouraud THEN
  1950.                      BEGIN
  1951.                          FOR I:=1 TO NrPoints DO
  1952.                          BEGIN
  1953.                              EdgeLight[I]:=0;
  1954.                              EdgeLightCount[I]:=0;
  1955.                          END;
  1956.                          FOR I:=1 TO ObjectCount DO LightObject(I);
  1957.                             FOR I:=1 TO NrPoints DO EdgeLight[I]:=EdgeLight[I]
  1958. DIV EdgeLightCount[I];
  1959.                      END;
  1960.                      FOR I:=1 TO ObjectCount DO DrawObject(I);
  1961.                      IF NOT ModeX THEN TransferScreen;
  1962.  
  1963.                      FOR I:=1 TO Byte(Timer-LastTimer) DO
  1964.                      BEGIN
  1965.                             IF Key[75] THEN Dec(XOfs,4096);
  1966.                             IF Key[77] THEN Inc(XOfs,4096);
  1967.                             IF Key[72] THEN Dec(YOfs,4096);
  1968.                             IF Key[80] THEN Inc(YOfs,4096);
  1969.                             IF Key[74] THEN Dec(ZOfs,4096);
  1970.                             IF Key[78] THEN Inc(ZOfs,4096);
  1971.                             IF Key[16] THEN Inc(U,8);
  1972.                             IF Key[17] THEN Inc(V,8);
  1973.                             IF Key[18] THEN Inc(W,8);
  1974.                             IF Key[30] THEN Dec(U,8);
  1975.                             IF Key[31] THEN Dec(V,8);
  1976.                             IF Key[32] THEN Dec(W,8);
  1977.                      END;
  1978.  
  1979.                      U:=(U+3620) MOD 3600;
  1980.                      V:=(V+3620) MOD 3600;
  1981.                      W:=(W+3600) MOD 3600;
  1982.  
  1983. {$IFDEF MEASURE}
  1984.                      SetColor(0,0,0,0);
  1985. {$ENDIF}
  1986.  
  1987.                      Inc(Phase);
  1988.     UNTIL {(Phase=64) OR} Key[1];
  1989.  
  1990.     StopTimer;
  1991.     TextMode;
  1992.     Port[$43]:=$34;
  1993.     Port[$40]:=0;
  1994.     Port[$40]:=0;
  1995.     WriteLn(J/(Zeit/70.5):7:2,' fps');
  1996.     WriteLn(Zeit);
  1997.     SetIntVec($09,SaveInt09);
  1998. END.
  1999.  
  2000. {SPHERES.XYZ--------Diese Zeile bitte loeschen!------------------------------}
  2001. scal
  2002. 70
  2003.  
  2004. object
  2005. sphere
  2006.  
  2007. scal
  2008. 0.02
  2009.  
  2010. coords
  2011. 0 0 40
  2012. 0 0 40
  2013. 0 0 40
  2014. 0 0 40
  2015. 0 0 40
  2016. 0 0 40
  2017. 0 0 40
  2018. 0 0 40
  2019. 0 12 32
  2020. 9 9 32
  2021. 12 0 32
  2022. 9 -9 32
  2023. 0 -12 32
  2024. -9 -9 32
  2025. -12 0 32
  2026. -9 9 32
  2027. 0 25 12
  2028. 18 18 12
  2029. 25 0 12
  2030. 18 -18 12
  2031. 0 -25 12
  2032. -18 -18 12
  2033. -25 0 12
  2034. -18 18 12
  2035. 0 25 -12
  2036. 18 18 -12
  2037. 25 0 -12
  2038. 18 -18 -12
  2039. 0 -25 -12
  2040. -18 -18 -12
  2041. -25 0 -12
  2042. -18 18 -12
  2043. 0 12 -32
  2044. 9 9 -32
  2045. 12 0 -32
  2046. 9 -9 -32
  2047. 0 -12 -32
  2048. -9 -9 -32
  2049. -12 0 -32
  2050. -9 9 -32
  2051. 0 0 -40
  2052. 0 0 -40
  2053. 0 0 -40
  2054. 0 0 -40
  2055. 0 0 -40
  2056. 0 0 -40
  2057. 0 0 -40
  2058. 0 0 -40
  2059.  
  2060. faces
  2061. 1 9 10
  2062. 2 10 11
  2063. 3 11 12
  2064. 4 12 13
  2065. 5 13 14
  2066. 6 14 15
  2067. 7 15 16
  2068. 8 16 9
  2069. 9 17 18 10
  2070. 10 18 19 11
  2071. 11 19 20 12
  2072. 12 20 21 13
  2073. 13 21 22 14
  2074. 14 22 23 15
  2075. 15 23 24 16
  2076. 16 24 17 9
  2077. 17 25 26 18
  2078. 18 26 27 19
  2079. 19 27 28 20
  2080. 20 28 29 21
  2081. 21 29 30 22
  2082. 22 30 31 23
  2083. 23 31 32 24
  2084. 24 32 25 17
  2085. 25 33 34 26
  2086. 26 34 35 27
  2087. 27 35 36 28
  2088. 28 36 37 29
  2089. 29 37 38 30
  2090. 30 38 39 31
  2091. 31 39 40 32
  2092. 32 40 33 25
  2093. 33 42 34
  2094. 34 43 35
  2095. 35 44 36
  2096. 36 45 37
  2097. 37 46 38
  2098. 38 47 39
  2099. 39 48 40
  2100. 40 41 33
  2101.  
  2102. objend
  2103.  
  2104.  
  2105.  
  2106.